home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / editors / dbuplus / dbuindx.prg < prev    next >
Encoding:
Text File  |  1992-09-23  |  5.3 KB  |  272 lines
  1. ************
  2. *
  3. *    Program....:  DBU
  4. *    Filename...:  DBUINDX.PRG
  5. *    Author.....:  Dennis L. Dias
  6. *    Date.......:  06/18/86, 06/18/90
  7. *    Purpose....:  Index Read/Write Module
  8. *
  9. *    Copyright (c) 1986-1990 Nantucket Corp., All Rights Reserved.
  10. *
  11. ************
  12.  
  13. #include "gaugeind.ch"
  14. ******
  15. *    make_ntx
  16. *
  17. *    create index file
  18. *
  19. *    note: see multibox in DBUUTIL.PRG
  20. ******
  21.  
  22. PROCEDURE make_ntx
  23. local saveColor
  24. PRIVATE filename, files, fi_disp, okee_dokee, cur_el, rel_row, def_ext,;
  25.         bcur, fi_done, el, cr, ntx, k_exp
  26.  
  27. * set local variables to macro reference specific arrays
  28. cr = "cr" + SUBSTR("123456", M->cur_area, 1)
  29. el = "el" + SUBSTR("123456", M->cur_area, 1)
  30. ntx = "ntx" + SUBSTR("123456", M->cur_area, 1)
  31.  
  32. * get name of current index file
  33. filename = &ntx[&el[2]]
  34.  
  35. * hi-lite the current index file..even if empty
  36. saveColor := SetColor(M->color2)
  37. @ &cr[2], column[M->cur_area] + 2 SAY pad(name(M->filename), 8)
  38.  
  39. * temporarily disable any relations and filters that may be active
  40. SELECT (M->cur_area)
  41. SET FILTER TO
  42. CLOSE INDEX
  43. need_filtr = .T.
  44. need_ntx = .T.
  45. not_target(SELECT(), .F.)
  46. SELECT (M->cur_area)
  47.  
  48. * initialize variables for multibox sub-system
  49. cur_el = 1
  50. rel_row = 0
  51. files = "ntx_list"
  52. def_ext = INDEXEXT()
  53.  
  54. IF .NOT. EMPTY(M->filename)
  55.     * set up for quick re-index
  56.     k_exp = ntx_key(M->filename)
  57.     bcur = 4
  58.  
  59. ELSE
  60.     * assume new file to be created
  61.     k_exp = ""
  62.     bcur = 2
  63.  
  64. ENDIF
  65.  
  66. * establish array of functions for multi-box
  67. DECLARE boxarray[7]
  68.  
  69. boxarray[1] = "ntx_title(sysparam)"
  70. boxarray[2] = "ntx_getfil(sysparam)"
  71. boxarray[3] = "ntx_exp(sysparam)"
  72. boxarray[4] = "ok_button(sysparam)"
  73. boxarray[5] = "unique_button(sysparam)"
  74. boxarray[6] = "can_button(sysparam)"
  75. boxarray[7] = "filelist(sysparam)"
  76.  
  77. * define certain sub-processes
  78. fi_disp = "ntx_exist()"
  79. fi_done = "ntx_done()"
  80. okee_dokee = "do_index()"
  81.  
  82. IF multibox(13, 17, 9, M->bcur, M->boxarray) <> 0 .AND.;
  83.    aseek(&ntx, M->filename) = 0
  84.     * index file generated and not open
  85.  
  86.     IF M->n_files < 14 .OR. .NOT. EMPTY(&ntx[&el[2]])
  87.         * room for one more..bring index file into View
  88.  
  89.         IF EMPTY(&ntx[&el[2]])
  90.             * keep track of number of open files
  91.             n_files = M->n_files + 1
  92.  
  93.         ENDIF
  94.  
  95.         * place in global array
  96.         &ntx[&el[2]] = M->filename
  97.  
  98.     ENDIF
  99. ENDIF
  100.  
  101. * re-write index filename as normal
  102. saveColor := SetColor(M->color1)
  103. @ &cr[2], column[M->cur_area] + 2 SAY pad(name(&ntx[&el[2]]), 8)
  104.  
  105. SetColor(saveColor)
  106. RETURN
  107.  
  108.  
  109. *******************************
  110. * support functions for INDEX *
  111. *******************************
  112.  
  113. ******
  114. *    ntx_title()
  115. *
  116. *    display title for "index"
  117. ******
  118. FUNCTION ntx_title
  119.  
  120. PARAMETERS sysparam
  121.  
  122. RETURN box_title(M->sysparam, "Index " +;
  123.                               SUBSTR(M->cur_dbf, RAT("\", M->cur_dbf) + 1) +;
  124.                               " to...")
  125.  
  126.  
  127. ******
  128. *    ntx_getfil()
  129. *
  130. *    get target filename for "index"
  131. ******
  132. FUNCTION ntx_getfil
  133.  
  134. PARAMETERS sysparam
  135.  
  136. RETURN getfile(M->sysparam, 4)
  137.  
  138.  
  139. ******
  140. *    ntx_done()
  141. *
  142. *    preliminary test of filename typed into entry field
  143. ******
  144. FUNCTION ntx_done
  145.  
  146. PRIVATE done_ok
  147.  
  148. done_ok = .NOT. EMPTY(M->filename)
  149.  
  150. IF M->done_ok
  151.     * filename entered
  152.  
  153.     IF FILE(M->filename) .AND. EMPTY(M->k_exp)
  154.         * read and display the key expression from the index file
  155.         k_exp = ntx_key(M->filename)
  156.         ntx_exp(3)
  157.  
  158.     ENDIF
  159.  
  160.     IF EMPTY(M->k_exp)
  161.         * move cursor to expression field
  162.         KEYBOARD CHR(24)
  163.  
  164.     ELSE
  165.         * expression entered..move cursor to the "Ok" button
  166.         to_ok()
  167.  
  168.     ENDIF
  169. ENDIF
  170.  
  171. RETURN M->done_ok
  172.  
  173.  
  174. ******
  175. *    ntx_exp()
  176. *
  177. *    get key expression for "index"
  178. ******
  179. FUNCTION ntx_exp
  180.  
  181. PARAMETERS sysparam
  182.  
  183. RETURN get_exp(M->sysparam, "KEY    ", 6, "k_exp")
  184.  
  185.  
  186. ******
  187. *    ntx_exist()
  188. *
  189. *    display filename selected from list and get key from file
  190. ******
  191. FUNCTION ntx_exist
  192.  
  193. IF EMPTY(M->k_exp)
  194.     * expression not entered..read it from the selected index file
  195.     k_exp = ntx_key(M->filename)
  196.  
  197. ENDIF
  198.  
  199. * display the filename and key
  200. ntx_getfil(3)
  201. ntx_exp(3)
  202.  
  203. RETURN 0
  204.  
  205.  
  206. ******
  207. *    do_index()
  208. *
  209. *    do the index command
  210. *
  211. *    note: this function is called when <enter> is pressed
  212. *          while the cursor is on the "Ok" button
  213. ******
  214. FUNCTION do_index
  215.  
  216. PRIVATE done, n_dup, new_el, add_name
  217.  
  218. * get number of select area using this index if any
  219. n_dup = dup_ntx(M->filename)
  220.  
  221. DO CASE
  222.  
  223.     CASE EMPTY(M->filename)
  224.         error_msg("Index file not selected")
  225.         done = .F.
  226.  
  227.     CASE M->n_dup > 0 .AND. M->n_dup <> SELECT()
  228.         error_msg("Index in use by another data file")
  229.         done = .F.
  230.  
  231.     CASE EMPTY(M->k_exp)
  232.         error_msg("Index key not entered")
  233.         done = .F.
  234.  
  235.     CASE .NOT. RIGHT(TYPE(M->k_exp),1) $ "CNDI"
  236.         error_msg("Key expression not valid")
  237.         done = .F.
  238.  
  239.     OTHERWISE
  240.         * ok to generate index
  241.         stat_msg("Generating index file")
  242.         add_name = .NOT. FILE(name(M->filename) + INDEXEXT())
  243.     INDEX ON &(m->k_exp) TO (M->filename)        ;
  244.         GAUGE @ 5,10,7,MAXCOL()-10               ;
  245.               COLOR "B/W,GR+/W"
  246.         CLOSE INDEX
  247.  
  248.         IF AT(INDEXEXT(), M->filename) = LEN(M->filename) - 3 .AND.;
  249.            FILE(name(M->filename) + INDEXEXT()) .AND. M->add_name
  250.             * add only .ntx files in the current directory
  251.  
  252.             new_el = afull(M->ntx_list) + 1
  253.  
  254.             IF M->new_el <= LEN(M->ntx_list)
  255.                 * add file to array
  256.                 ntx_list[M->new_el] = M->filename
  257.                 array_sort(M->ntx_list)
  258.  
  259.             ENDIF
  260.         ENDIF
  261.  
  262.         stat_msg("File indexed")
  263.         done = .T.
  264.  
  265. ENDCASE
  266.  
  267. RETURN M->done
  268.  
  269.  
  270. * EOF DBUINDX.PRG
  271. 
  272.